rm(list=ls(all=TRUE))
setwd(RootDir)
RootDir <- getwd()
source(paste(RootDir,"/fun.txt",sep = "/"))
data<-data.frame(read.csv("RealDataAdj.csv"))

#################### Simple interpolation #######################

RootDir <- getwd()
options(warn = -1)
#(a,b) the dimentions of the data matrix
a<-dim(data)[1]
b<-dim(data)[2]-1
j.i=0.25
l.i=15.5
nmat<-l.i/j.i
ZC<-matrix(0,a-2,nmat,dimnames=list(as.character(data[3:a,1]),round(seq(j.i,l.i,j.i),5)))
FR<-matrix(0,a-2,nmat,dimnames=list(as.character(data[3:a,1]),round(seq(j.i,l.i,j.i),5)))

################## Split into dates, CPI, real and nomianl data ####

dates <- data[1:a,1]
CPI <- data[1:a,2:5]
real <- data[1:a, 6:(b-43)]
nominal <- data[1:a, (b-41):(b-1)]
forward <- data[1:a,b]
nr <- b - 42 - 6
nn <- 64
# Nominal beyond 10 year converges to 10y forward rate - yield equals average of forwards
for(k in 42:nn){nominal[,k] <- (nominal[,k-1]*(k-2) + forward)/(k-1)}

################## Loop; first set up the data #######################

for(q in 3:a){

print(q)

# Set up dates and filter bonds - discard those <1y or >15.5y to maturity (as nominal yields only go 10y)
# x is a vector of TRUE/FALSE saying if a bond is outstanding on that day, and also discarding if bond is too short or long
Today <- as.Date(dates[q],"%d/%m/%Y")
s <- set(Today)[1]
mat<-as.Date(as.matrix(real[2,]),"%d/%m/%Y")
x<-!is.na(as.numeric(as.matrix(real[q,])))
for(j in 1:nr){
	if((mat[j]-Today)/365 < 1){x[j]<-FALSE}
	if((mat[j]-Today)/365 > 15.5){x[j]<-FALSE}
}

#Number of outstanding bonds
n<-sum(x>0,na.rm=T)
Issue.ID<-rep(0,n)

#Coupon payments - only takes those applicable for the date
Coupon<-NULL
coup<-as.numeric(as.matrix(real[1,]))
j<-0
for(i in 1:nr){
j<-j+1
ifelse(x[i],Coupon[j]<-coup[i],j<-j-1)}

#Maturity
Maturity<-as.Date(dates[q],"%d/%m/%Y")
#Sets maturity of bonds
j<-0
for(i in 1:nr){
	j<-(j+1)
	ifelse(x[i],Maturity[j]<-as.Date(mat[i]),j<-(j-1))
}

#Yields for relevant bonds
Yield<-NULL
yie<-as.numeric(as.matrix(real[q,]))
j<-0
for(i in 1:nr){
	j<-j+1
	ifelse(x[i],Yield[j]<-yie[i],j<-j-1)
}

################## Loop; calculate CC forward rate #################

# Define objective function - bond price minus price implied by real yield y
ftmp <- function(y,Pr,Cn1,Cn2,yn2,Cr,tau){
	Imp <- sum(Cn1) + Cn2*exp((yn2-y)/8) + sum(Cr*exp(-y*tau/365))
	abs(Pr - Imp)}

i <- 1
# Set up bond price in terms of coupons and real yields
Pr <- p(Today,Maturity[i],Yield[i],Coupon[i],s)
coup <- coupon(Today,Maturity[i],Coupon[i],s)
ta <- tau(Today,Maturity[i],Coupon[i],s)

# nCPI is number of CPI readings known but not in K factor - if next coupon comes before next CPI, we know two
nCPI <- ifelse(as.Date(CPI[q,1],"%d/%m/%Y")-Today > ta[1],2,1)

# K factor updates by half the semi-annual change, so the last 2 CPI readings are applied for 1 quarter, and half of the last is applied for 1 more quarter, which I treat as applying the whole last CPI reading for half a quarter more (365/8 = 46)
Delta <- ta[nCPI] + 46

# Make the nominal yield factors; first interpolate to get y_tau, then interpolate to get y_{tau - D} (always half way between quarters), then calculate factors
ynt <- as.numeric(nominal[q,1:(nn-1)]*(1-ta[1]/92) + nominal[q,2:nn]*(ta[1]/92))
yntmd <- ynt*0
yntmd[(nCPI+1):(nn-1)] <- as.numeric(nominal[q,1:(nn-nCPI-1)]*0.5 + nominal[q,2:(nn-nCPI)]*0.5)
yn <- ynt*0
for(k in 1:(nCPI+1)){yn[k] <- exp(-ynt[k]*ta[k]/36500)}
for(k in (nCPI+2):(nn-1)){yn[k] <- exp(-ynt[k]*ta[k]/36500 + yntmd[k]*(ta[k]-Delta)/36500)}

# Pi[i] the known inflation to the [ith] coupon, where for the [nCPI]th coupon we only add the CPI we know, with the next CPI reading being the nomianl yield less the fitted real yield (added in the ftmp function). Pi[last] captures the last reading of CPI that is only half incorporated
Pi <- NULL
if(nCPI == 1){Pi[1] <- ((1 + 0.5*((1+CPI[q,2]/100)*(1+CPI[q,3]/100)-1)))^(ta[1]/92); Pi[2] <- Pi[1]*(1+CPI[q,2]/100)^(.5)}
if(nCPI == 2){Pi[1] <- ((1 + 0.5*((1+CPI[q,3]/100)*(1+CPI[q,4]/100)-1)))^(ta[1]/92); Pi[2] <- Pi[1]*(1 + 0.5*((1+CPI[q,2]/100)*(1+CPI[q,3]/100)-1)); Pi[3] <- Pi[2]*(1+CPI[q,2]/100)^(.5)}
n2 <- length(coup)

out <- optim(Yield[i]/100, ftmp, Pr=Pr, Cn1=yn[1:nCPI]*Pi[1:nCPI]*coup[1:nCPI], Cn2=yn[nCPI+1]*Pi[nCPI+1]*coup[nCPI+1], yn2=ynt[nCPI]/100, Cr=yn[(nCPI+2):n2]*Pi[nCPI+1]*coup[(nCPI+2):n2], tau=(ta[(nCPI+2):n2]-Delta))

FR[q-2,1:(n2-nCPI)] <- out$par
ZC[q-2,1:(n2-nCPI)] <- out$par

for(i in 2:n){

	Pr <- p(Today,Maturity[i],Yield[i],Coupon[i],s)

	# Which coupons shoudl be priced off existing yield curve
	coup <- coupon(Today,Maturity[i],Coupon[i],s)
	ta <- tau(Today,Maturity[i],Coupon[i],s)
	n1 <- length(coupon(Today,Maturity[i-1],Coupon[i-1],s))
	n2 <- length(coup)

	# nCPI is number of CPI readings known but not in K factor - if next coupon comes before next CPI, we know two
	nCPI <- ifelse(as.Date(CPI[q,1],"%d/%m/%Y")-Today > ta[1],2,1)
	# K factor updates by half the semi-annual change, so the last 2 CPI readings are applied for 1 quarter, and half of the last is applied for 1 more quarter, which I treat as applying the whole last CPI reading for half a quarter more (365/8 = 46)
	Delta <- ta[nCPI] + 46

	# Make the nominal yield factors; first interpolate to get y_tau, then interpolate to get y_{tau - D}, then calculate factors
	ynt <- as.numeric(nominal[q,1:(nn-1)]*(1-ta[1]/92) + nominal[q,2:nn]*(ta[1]/92))
	yntmd <- ynt*0
	yntmd[(nCPI+1):(nn-1)] <- as.numeric(nominal[q,1:(nn-nCPI-1)]*0.5 + nominal[q,2:(nn-nCPI)]*0.5)
	yn <- ynt*0
	for(k in 1:(nCPI+1)){yn[k] <- exp(-ynt[k]*ta[k]/36500)}
	for(k in (nCPI+2):(nn-1)){yn[k] <- exp(-ynt[k]*ta[k]/36500 + yntmd[k]*(ta[k]-Delta)/36500)}

	# Pi[i] the known inflation to the [ith] coupon, where for the [nCPI]th coupon we only add the CPI we know, with the next CPI reading being the nomianl yield less the fitted real yield. Pi[last] captures the last reading of CPI that is only half incorporated
	Pi <- NULL
	if(nCPI == 1){Pi[1] <- ((1 + 0.5*((1+CPI[q,2]/100)*(1+CPI[q,3]/100)-1)))^(ta[1]/92); Pi[2] <- Pi[1]*(1+CPI[q,2]/100)^(.5)*exp((ynt[nCPI]/100-FR[q-2,1])/8); Pi[3] <- Pi[1]*(1+CPI[q,2]/100)^(.5)}
	if(nCPI == 2){Pi[1] <- ((1 + 0.5*((1+CPI[q,3]/100)*(1+CPI[q,4]/100)-1)))^(ta[1]/92); Pi[2] <- Pi[1]*(1 + 0.5*((1+CPI[q,2]/100)*(1+CPI[q,3]/100)-1)); Pi[3] <- Pi[2]*(1+CPI[q,2]/100)^(.5)*exp((ynt[nCPI]/100-FR[q-2,1])/8); Pi[4] <- Pi[2]*(1+CPI[q,2]/100)^(.5)}

	# yield curve implied by previous bonds - average of forward rates
	ytmp <- FR[q-2,1]
	for(k in 2:(n1-nCPI)){ytmp[k] <- weighted.mean(FR[q-2,1:k],c(rep(0.25,k-1),(ta[k+nCPI+1]-Delta)/365 - k*.25))}

	# Pricing function imputs; first nCPI + 1 same as before, rest are to price coupons where we know the real yield already from first step (ytmp), but still need to make lag adjustment as per PDF
	yn1 <- c(yn[1:(nCPI+1)],exp(-ytmp[2:(n1-nCPI)]*(ta[(nCPI+2):n1]-Delta)/365))
	Pi1 <- c(Pi[1:(nCPI+1)],rep(Pi[nCPI+2],n1-nCPI-1)*yn[(nCPI+2):n1])
	out <- optim(Yield[i]/100, ftmp, Pr=Pr, Cn1=yn1*Pi1*coup[1:n1], Cn2=0, yn2=0, Cr=yn[(n1+1):n2]*Pi[nCPI+2]*coup[(n1+1):n2], tau=(ta[(n1+1):n2]-Delta))

	# Get correct yield curve via appropriate average of forward rates
	From <- n1-nCPI+1
	To <- n2-nCPI
	if(i==n){To<-l.i/j.i}
	if(To>=From){
	  if(FR[q-2,From-1]==0){FR[q-2,From-1]<-FR[q-2,From-2]
	  ZC[q-2,From-1]<-mean(FR[q-2,1:From-1])}
		FR[q-2,From:To] <- out$par
		for(j in From:To){ZC[q-2,j] <- mean(FR[q-2,1:j])}}
}

}
################## Start look over dates #######################

write.csv(round(ZC,5),"ZC_Interpolated_Adj.csv")
write.csv(round(FR,5),"FR_Interpolated_Adj.csv")

